home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 026a / form_doc.zip / FORM_DOC.COD
Text File  |  1991-07-15  |  54KB  |  1,757 lines
  1. // Module Name: FORM.COD FOR 1.1
  2. // Description: This module produces dBASE IV .FMT files
  3. //              with popups for VALID clause field validation and
  4. //              Context Sensitive Help for each field
  5. //
  6.  
  7. Format (.fmt) File Template with POPUP field validation
  8. -------------------------------------------------------
  9. Version 1.1.19
  10. Ashton-Tate (c) 1987, 1988, 1989, 1990
  11. Written by Kirk J. Nason & Bill Ramos
  12.  
  13. This template will support POPUPs for VALID clause field validations and
  14. context sensitive help for each field.
  15.  
  16. Example: In "ACCEPT value when" under "Edit options" enter,
  17.         "POPUP" = "vendor->vendor_id ORDER vendor_id REQ SHADOW"
  18.         --------------------------------------------------------
  19.         this will activate a popup if the data entered is invalid for
  20.         that field and will also make the field REQUIRED.
  21.  
  22. Explanation of the POPUP string follows:
  23.  
  24. POPUP              Indicates that a popup will be used for this field.
  25. vendor->vendor_id  Indicates the .DBF to open and FIELD to use as validation.
  26. ORDER vendor_id    Indicates which INDEX TAG to SEEK in.
  27. REQ                Indicates the FIELD requires data (can't be empty).
  28.                    Leave REQ out if the field is NOT required.      OPTIONAL!
  29. SHADOW             Use shadowing effect on popups                   OPTIONAL!
  30. NOTE: The POPUP string must be entered with the quotes as in the example.
  31.  
  32. --------------------------------------------------------------------------------
  33.  
  34. Explanation of the Context Sensitive Help file follows:
  35.  
  36. If you want to create your own help file, here is the structure that is required.
  37.  
  38. Structure for Help Database (.dbf):
  39. <first 6 chars. of the format file name>_H.dbf
  40.  
  41. Field   Field Name  Type        Width  Dec   Tag
  42. -------------------------------------------------
  43.     1   FLD_NAME    Character     10         Yes  Field name to lookup on F1
  44.     2   FLD_HEADNG  Character     25          No  Heading to show user on window
  45.     3   FLD_HELP    Memo          10          No  Help text to show user
  46. -------------------------------------------------
  47.         Total                     46
  48. {
  49. include "form.def"    // Form selectors
  50. include "builtin.def" // Builtin functions
  51. //
  52. // Enum string constants for international translation
  53. //
  54. enum  wrong_class = "Can't use FORM.GEN on non-form objects.  ",
  55.       form_empty  = "Form design was empty.  ",
  56.       bad_pick    = "Picklist coordinates exceed column 79 - move field left",
  57.       bad_shadow  = "Shadow coordinates exceed column 79 - move field left",
  58.       select_msg1 = "[Select: ]+CHR(17)+CHR(196)+CHR(217)+[   Cancel: Esc]",
  59.       help_msg1   = "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Esc   ",
  60.       help_msg2   = "See Original Screen: F3"
  61. ;
  62. enum  offset = 3  // Offset for lmarg()
  63.       width_of_wrap = 46,
  64.       indent_no = 20,
  65.       type_char  = 67,
  66.       type_date  = 68,
  67.       type_float = 70,
  68.       type_bool  = 76,
  69.       type_memo  = 77,
  70.       type_numb  = 78;
  71. //
  72.  
  73. if FRAME_CLASS != form then // We are not processing a form object
  74.   pause(wrong_class + any_key)
  75.   goto NoGen;
  76. endif
  77.  
  78. var  fmt_name,     // Format file name
  79.      crlf,         // line feed
  80.      carry_flg,    // Flag to test carry loop
  81.      carry_cnt,    // Count of the number of fields to carry
  82.      carry_len,    // Cumulative length of carry line until 75 characters
  83.      carry_lent,   // Total cumulative length of carry line
  84.      carry_first,  // Flag to test "," output for carry fields
  85.      color_flg,    // Flag to if color should stay on am line
  86.      line_cnt,     // Count for total lines processed (Mulitple page forms)
  87.      page_cnt,     // Count for total pages processed (Mulitple page forms)
  88.      temp,         // tempory work variable
  89.      cnt,          // Foreach loop variable
  90.      wnd_cnt,      // Window counter
  91.      wnd_names,    // Window names so I can clear them at the bottom of the file
  92.      default_drv,  // dBASE default drive
  93.      dB_status,    // dBASE status before entering designer
  94.      scrn_size,    // Screen size when generation starts
  95.      left_delimiter, // Delimiter to put around SAY
  96.      right_delimiter,// Delimiter to put around SAY
  97.      max_pop_row,  // Maximum row that a popup or shadow can start
  98.      display,      // Type of display screen we are on
  99.      is_popup,     // POPUP validation requested
  100.      is_help,      // HELP (context sensitive) requested
  101.      udf_file,     // UDF file has been created
  102.      hlp_name,     // HELP .dbf name
  103.      trow_positn,  // Temporary variable for row_positn
  104.      tcol_positn,  // Temporary variable for col_positn
  105.      at_pop,       // "POPUP" is in FLD_OK_COND
  106.      color;        // Color returned from getcolor function
  107.  //---------------------------------------------
  108.  //  Documenting procedure variables
  109.  //---------------------------------------------
  110.  var
  111.      parse_str,    // String to parse during line formatting
  112.      temp_str,     // Temporary string used for parsing
  113.      test1,       // Temporary variable use in line formatting
  114.      remain_str,   // Text left over from formatting procedure    
  115.      last_at,       // Position where left off last line formatted
  116.      cntr1,       // Counter variable
  117.      breakpt1,       // Point in string where string is broken for eoln    
  118.      breakpt2,       // Point in string where string is broken for eoln
  119.      first_time,   // First time through loop flag
  120.      first,        // First time through loop flag
  121.      testing,      // First time through loop flag
  122.      first_test;   // First time through loop flag
  123.  
  124.  //-----------------------------------------------
  125.  // Assign default values to some of the variables
  126.  //-----------------------------------------------
  127.  carry_flg = carry_first = carry_cnt = carry_len = carry_lent =
  128.  wnd_cnt = line_cnt =  color_flg = cnt = 0
  129.  crlf = chr(10)
  130.  temp = ""
  131.  page_cnt = 1
  132.  is_popup = is_help = udf_file = 0
  133.  left_delimiter = right_delimiter = "\""
  134.  
  135.  screen_size()
  136.  if !make_Fmt_doc() then goto nogen
  137.  doc_header()                   // Print Header in the Doc file
  138.  fmt_doc_body()            // Create Documentation
  139.  //-------------------------------
  140.  // Create Format file
  141.  //-------------------------------
  142.  if !make_Fmt() then goto nogen
  143.  
  144.  header()                   // Print Header in the Format file
  145.  fmt_file_initialization()  // Format file initializtion code
  146.  fmt_file_body()            // @ SAY GET Processing
  147.  fmt_file_exit()            // Format file exit code
  148.  make_pop_code()            // Create the Procedure File for POPUP's if required
  149.  make_help_code()           // Make procedures for the help system
  150.  
  151.  if cnt == 0 then
  152.     pause(form_empty + any_key)
  153.  endif
  154.  fileerase(fmt_name+".FMO")
  155.  nogen:
  156. return 0;
  157.  
  158.  
  159. //---------------------------------------
  160. // Template user defined functions follow
  161. //---------------------------------------
  162.  
  163. define fmt_file_initialization()
  164. //
  165. // Format file initialization code
  166. //
  167. }
  168.  
  169. *-- Format file initialization code --------------------------------------------
  170.  
  171. *-- Some of these PRIVATE variables are created based on CodeGen and may not 
  172. *-- be used by your particular .fmt file
  173. PRIVATE lc_talk, lc_cursor, lc_display, lc_status, lc_carry, lc_proc,;
  174.         ln_typeahd, gc_cut
  175.  
  176. IF SET("TALK") = "ON"
  177.    SET TALK OFF
  178.    lc_talk = "ON"
  179. ELSE
  180.    lc_talk = "OFF"
  181. ENDIF
  182. lc_cursor = SET("CURSOR")
  183. SET CURSOR ON
  184. {if at("43", display_type()) then}
  185.  
  186. *-- This form was created in {display_type()} mode
  187. lc_display = SET("display")
  188. // MONO, COLOR, EGA25, EGA43, MONO43
  189. IF .NOT. "43" $ lc_display                             && In 25 line mode
  190.    IF "EGA" $ lc_display
  191.       *-- If EGA is in lc_display try EGA43
  192.       SET DISPLAY TO EGA43                     
  193.    ELSE
  194.       *-- Otherwise try MONO43
  195.       SET DISPLAY TO MONO43
  196.    ENDIF
  197. ENDIF
  198. {endif}
  199.  
  200. lc_status = SET("STATUS")
  201. *-- SET STATUS was \
  202. {if dB_status then}
  203. ON when you went into the Forms Designer.
  204. IF lc_status = "OFF"
  205.    SET STATUS ON
  206. {else}
  207. OFF when you went into the Forms Designer.
  208. IF lc_status = "ON"
  209.    SET STATUS OFF
  210. {endif}
  211. ENDIF
  212. //-----------------------------------------------------------------------
  213. // Process fields to build "SET CARRY" and WINDOW commands.
  214. //-----------------------------------------------------------------------
  215. {
  216.  foreach FLD_ELEMENT flds
  217.    new_page(flds)
  218.    if FLD_CARRY then carry_flg = 1; ++carry_cnt endif
  219.    if chr(FLD_VALUE_TYPE) == "M" and FLD_MEM_TYP and wnd_cnt < 20 then
  220.       ++wnd_cnt
  221.       wnd_names = wnd_names + "wndow" + wnd_cnt + ",";
  222. }
  223.  
  224. *-- Window for memo field {cap_first(FLD_FIELDNAME)}.
  225. DEFINE WINDOW { Window_Def(flds)}\
  226. {  endif
  227.  next flds
  228.  print(crlf);
  229.  if carry_flg then
  230. }
  231.  
  232. lc_carry = SET("CARRY")
  233. *-- Fields to carry forward during APPEND.
  234. SET CARRY TO { Carry_Flds()}
  235.  
  236. {endif}
  237. {
  238.  if check_for_popups() then
  239. }
  240.  
  241. ON KEY LABEL F2 ?? chr(7)
  242.  
  243. lc_proc = SET("procedure")                       && Store procedure file name
  244. SET PROCEDURE TO u_{substr(name,1,6)}
  245.  
  246. {    endif
  247.      if check_for_help() then
  248.         if !is_popup then}
  249. lc_proc = SET("procedure")                       && Store procedure file name
  250. SET PROCEDURE TO u_{substr(name,1,6)}
  251. {       endif}
  252. ON KEY LABEL F1 DO Help WITH VARREAD()
  253. {    endif
  254. return;
  255. // eof - fmt_file_init()
  256. enddef
  257.  
  258. //--------------------------------------------------------------
  259. define fmt_file_body()
  260. }
  261.  
  262. *-- @ SAY GETS Processing. -----------------------------------------------------
  263.  
  264. *--  Format Page: {page_cnt = 1
  265.                    page_cnt}
  266.  
  267. {line_cnt = wnd_cnt = 0
  268.  foreach ELEMENT k
  269.    color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  270.    if new_page(k) then
  271. }
  272. READ
  273.  
  274. *-- Format Page: {page_cnt}
  275.  
  276. {  endif
  277. //
  278.  
  279.    if ELEMENT_TYPE == @TEXT_ELEMENT or ELEMENT_TYPE == @FLD_ELEMENT then
  280.      if FLD_FIELDTYPE == calc then
  281. }
  282. *-- Calculated field: {cap_first(FLD_FIELDNAME)} - {FLD_DESCRIPT}
  283. {    endif
  284.      if FLD_FIELDTYPE == memvar then
  285. }
  286. *-- Memory variable: {cap_first(FLD_FIELDNAME)}
  287. {    endif}
  288. @ {nul2zero(ROW_POSITN) - line_cnt},{nul2zero(COL_POSITN)} \
  289. {  endif
  290.    if ELEMENT_TYPE == @BOX_ELEMENT then
  291. }
  292. @ {box_coordinates(k)}\
  293. {  endif}
  294. //
  295. {  case ELEMENT_TYPE of
  296.    @TEXT_ELEMENT:
  297.    // Certain control characters can cause dBASE problems ie, ASCII(13,26,0)
  298.    // so the form designer will either send them to us as a string if they are
  299.    // all the same character or as individual characters if they differ. We
  300.    // handle this by using the chr() function to "SAY" them in dBASE.
  301. }
  302. SAY \
  303. {     if asc(TEXT_ITEM) < 32 then
  304.         if len(TEXT_ITEM) == 1 then}
  305. CHR({asc(TEXT_ITEM)}) \
  306. {       else}
  307. REPLICATE(CHR({asc(TEXT_ITEM)}), {len(TEXT_ITEM)}) \
  308. {       endif
  309.       else
  310.          if substr(TEXT_ITEM,1,1) == "\"" then
  311.             // Double quote is being used on the design surface need to use
  312.             // brackets "[]" as delimiters
  313.             left_delimiter = "["
  314.             right_delimiter = "]"
  315.          endif
  316.          left_delimiter + TEXT_ITEM + right_delimiter} \
  317. {        left_delimiter = right_delimiter = "\""
  318.       endif
  319.       outcolor()}
  320. {  @Box_element:
  321.        outbox(BOX_TYPE, BOX_SPECIAL_CHAR)}
  322. {      outcolor()}
  323. {  @FLD_ELEMENT:
  324.       if !FLD_EDITABLE then; // its a SAY}
  325. SAY \
  326. {        if FLD_FIELDTYPE == calc then
  327.            // Loop thru expression in case it is longer than 237
  328.             foreach FLD_EXPRESSION fcursor in k
  329.                FLD_EXPRESSION}
  330. {           next}
  331. // Output a space after the Fld_expression and get ready for picture clause
  332.  \
  333. {        else // not a editable field
  334.             if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
  335.                temp + cap_first(FLD_FIELDNAME)} \
  336. {        endif
  337.          if Ok_Template(k) then}
  338. PICTURE "{picture_for_say(k);}" \
  339. {        endif
  340.       else // it's a get}
  341. GET \
  342. {        if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
  343.          temp + cap_first(FLD_FIELDNAME)} \
  344. {        if chr(FLD_VALUE_TYPE) == "M" && FLD_MEM_TYP then
  345.             if wnd_cnt < 20  then ++wnd_cnt endif
  346.             if Fld_mem_typ == 1}OPEN {endif}WINDOW wndow{wnd_cnt} \
  347. {        endif
  348.          if Ok_Template(k) then}
  349. PICTURE "{picture_for_get(k);}" \
  350. {        endif
  351.          if FLD_L_BOUND or FLD_U_BOUND then color_flg = 1;}
  352. ;
  353.    RANGE {FLD_L_BOUND}{if FLD_U_BOUND then},{FLD_U_BOUND}{endif} \
  354. {        endif
  355.          if FLD_OK_COND then color_flg = 1;}
  356. ;
  357. {           if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" and
  358.                ok_coordinates( k, 2, 1, bad_pick ) then
  359.                // A POPUP is desired for showing coded values, redo the
  360.                // VALID clause to call a UDF based on "U_" + FLD_FIELDNAME
  361. }
  362.    VALID {if is_required(FLD_OK_COND)}REQUIRED {endif}\
  363. {  get_udfname(FLD_FIELDNAME)}( {cap_first(FLD_FIELDNAME)} ) \
  364. {
  365.             else
  366.                 if !(at("POPUP", upper(ltrim(FLD_OK_COND))) == "2") then
  367. }
  368.    VALID {FLD_OK_COND} \
  369. {
  370.                 endif
  371.             endif
  372.  
  373.             if FLD_REJ_MSG then}
  374. ;
  375.    ERROR \
  376. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif}{FLD_REJ_MSG}\
  377. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif} \
  378. {           endif
  379.          endif // FLD_OK_COND
  380.          if FLD_ED_COND then color_flg = 1;}
  381. ;
  382.    WHEN {FLD_ED_COND} \
  383. {
  384.          endif
  385.          if FLD_DEF_VAL then color_flg = 1;}
  386. ;
  387.    DEFAULT {FLD_DEF_VAL} \
  388. {        endif
  389.          if FLD_HLP_MSG then color_flg = 1;}
  390. ;
  391.    MESSAGE \
  392. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif}{FLD_HLP_MSG}\
  393. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif} \
  394. {        endif
  395.       endif // FLD_EDITABLE
  396. }
  397. {     outcolor()}
  398. {     color_flg = 0;
  399.    otherwise: goto getnext;
  400.    endcase
  401. }
  402.  
  403. //Leave the above blank line, it forces a line feed!
  404. //-----------------
  405. // End of @ SAY GET
  406. //-----------------
  407. {  ++cnt;
  408.    getnext:
  409.  next k
  410. return;
  411. // eof - fmt_file_body()
  412. enddef
  413.  
  414. //--------------------------------------------------------------
  415. define fmt_file_exit()
  416. }
  417. *-- Format file exit code -----------------------------------------------------
  418.  
  419. *-- SET STATUS was \
  420. {if dB_status then}
  421. ON when you went into the Forms Designer.
  422. IF lc_status = "OFF"  && Entered form with status off
  423.    SET STATUS OFF     && Turn STATUS "OFF" on the way out
  424. {else}
  425. OFF when you went into the Forms Designer.
  426. IF lc_status = "ON"  && Entered form with status on
  427.    SET STATUS ON     && Turn STATUS "ON" on the way out
  428. {endif}
  429. ENDIF
  430. {if carry_flg then}
  431.  
  432. SET CARRY &lc_carry.
  433. {endif}
  434. SET CURSOR &lc_cursor.
  435. SET TALK &lc_talk.
  436. {if at("43", display_type()) then}
  437. SET DISPLAY TO &lc_display.      && Reset Screen size if changed
  438. {endif}
  439. {if wnd_names then}
  440.  
  441. RELEASE WINDOWS {substr(wnd_names, 1, (len(wnd_names) - 1))}
  442. {endif}
  443.  
  444. RELEASE {if carry_flg then}lc_carry,{endif}lc_talk,lc_fields,lc_status
  445. {    if is_help then}
  446.  
  447. ON KEY LABEL F1
  448. {    endif
  449.      if is_popup or is_help then}
  450. ON KEY LABEL F2
  451.  
  452. SET PROCEDURE TO (lc_proc)
  453. {    endif}
  454. *-- EOP: {filename(fmt_name)}FMT
  455. {return;
  456. // eof - fmt_file_exit()
  457. enddef
  458.  
  459. //--------------------------------------------------------------
  460. define picture_for_get(c)
  461.      if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  462. {       if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  463.  {//leave this space}\
  464. {       endif
  465.      if at("M", c.FLD_PICFUN) then
  466.         c.FLD_PIC_CHOICE}\
  467. {    else
  468.         c.FLD_TEMPLATE}\
  469. {    endif
  470.  return;
  471. enddef
  472.  
  473. //--------------------------------------------------------------
  474. define picture_for_say(c)
  475.      if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  476. {       if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  477.  {//leave this space}\
  478. {       endif
  479.      if !at("M", c.FLD_PICFUN) then
  480.         c.FLD_TEMPLATE}\
  481. {    endif
  482.  return;
  483. enddef
  484.  
  485. //--------------------------------------------------------------
  486. define make_pop_code()
  487. // Create the Procedure File for POPUP's if required
  488.      if is_popup then
  489.           if !make_udf() then 
  490.               return 0;
  491.           endif
  492.           udf_header()
  493. }
  494. FUNCTION Empty                && Determine if the passed argument is NULL
  495. PARAMETER x
  496.   mtype = TYPE("x")
  497.   DO CASE
  498.     CASE mtype = "C"
  499.       retval = (LEN(TRIM(x))=0)
  500.     CASE mtype$"NF"
  501.       retval = (x=0)
  502.     CASE mtype = "D"
  503.       retval = (" "$DTOC(x))
  504.   ENDCASE
  505. *-- EOP: empty
  506. RETURN (retval)
  507.  
  508. {
  509.           line_cnt = 0
  510.           page_cnt = 1
  511.  
  512.           foreach FLD_ELEMENT flds
  513.  
  514.                at_pop = at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" ? 1 : 0;
  515.  
  516.                new_page(flds)
  517.                if at_pop then
  518.                     trow_positn = nul2zero(ROW_POSITN) - line_cnt
  519.                     tcol_positn = nul2zero(COL_POSITN)
  520.                     color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  521.  
  522.                     if !ok_coordinates(flds, 2, 0, "") then loop endif
  523.  
  524.  
  525.                     print("*"+replicate("-",78)+crlf);}
  526. FUNCTION {get_udfname(FLD_FIELDNAME)}
  527.   PARAMETER fld_name
  528.   PRIVATE ALL LIKE ??_*
  529.   PRIVATE esckey, fld_name, rtn_fld
  530.   ll_return = .F.
  531.  
  532. {                   if !is_required(FLD_OK_COND) then}
  533.   IF empty(fld_name)                   && Not a required fiel cur.FLD_TEMPLATE
  534.      RETURN (.T.)                       && if null field
  535.   ENDIF
  536.  
  537. {                    endif}
  538.   EscKey = 27                          && 27 represents the ESC key
  539.  
  540.   lc_alias = ALIAS()                   && Grab current workarea
  541.   SELECT SELECT()
  542.   USE {get_file(FLD_OK_COND)} ORDER {get_key(FLD_OK_COND)} AGAIN
  543.  
  544.  
  545.   lc_exact = SET("EXACT")              && Store value of EXACT
  546.   SET EXACT ON
  547.  
  548. {                   if chr(FLD_VALUE_TYPE) == "C" then}
  549.   fld_name = IIF( EMPTY( TRIM( fld_name)), fld_name, TRIM( fld_name))
  550. {                   endif}
  551.   SEEK fld_name
  552.  
  553.   SET EXACT &lc_exact.                 && Restore SET EXACT to org. value
  554.   IF .NOT. FOUND()
  555.  
  556.       DEFINE POPUP {get_popname(FLD_OK_COND)} FROM \
  557. {         if trow_positn < max_pop_row then
  558.              trow_positn + 1},{tcol_positn} ;
  559.         TO {scrn_size-1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  560. {         else
  561.              trow_positn - 11},{tcol_positn} ;
  562.         TO {trow_positn - 1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  563. {         endif}
  564.         PROMPT FIELD {get_field(FLD_OK_COND)} ;
  565.         MESSAGE {select_msg1}
  566.  
  567.       ON SELECTION POPUP {get_popname(FLD_OK_COND)} DEACTIVATE POPUP
  568.  
  569. {                        if chr(FLD_VALUE_TYPE) == "C" then}
  570.       KEYBOARD TRIM(fld_name)
  571. {                   endif}
  572.       SAVE SCREEN TO temp
  573. {                   if is_shadow(FLD_OK_COND) and
  574.                        ok_coordinates( flds, 4, 1, bad_shadow ) then
  575. }
  576.       DO shadowg WITH {get_pop_shadow(FLD_TEMPLATE);}
  577.  
  578. {                   endif
  579. }
  580.       ACTIVATE POPUP {get_popname(FLD_OK_COND)}
  581.  
  582.       rtn_fld = PROMPT()                         && Get user choice from Piclist
  583.  
  584.       RELEASE POPUP {get_popname(FLD_OK_COND)}
  585.  
  586.       RESTORE SCREEN FROM temp
  587.  
  588.       IF LASTKEY() <> EscKey
  589.         @ {trow_positn},{tcol_positn} GET rtn_fld \
  590. {        if Ok_Template(flds) then}
  591. PICTURE "{picture_for_get(flds);}" \
  592. {           outcolor()}
  593. {        endif}
  594.  
  595.         CLEAR GETS
  596.  
  597.         REPLACE {cap_first(FLD_FILENAME)}->{cap_first(FLD_FIELDNAME)} WITH \
  598. {        if chr(FLD_VALUE_TYPE) == "C" then}
  599. rtn_fld
  600. {        else}
  601. VAL(rtn_fld)
  602. {        endif}
  603.  
  604.         ll_return = .T.
  605.       ELSE
  606.         ll_return = .F.
  607. {
  608.                     if !is_required(FLD_OK_COND) then
  609. }
  610.         IF EMPTY(fld_name)               && Not a required field, so return
  611.           ll_return = .T.
  612.         ENDIF
  613.  
  614. {
  615.                     endif
  616. }
  617.       ENDIF
  618.  
  619.   ELSE
  620.       ll_return = .T.
  621.   ENDIF
  622.  
  623.   USE
  624.   SELECT (lc_alias)                    && Go back to the edit file
  625.  
  626. *-- EOP: {get_udfname(FLD_FIELDNAME)}
  627. RETURN (ll_return)
  628.  
  629. {
  630.                endif
  631.           next flds
  632.           print("*"+replicate("-",78)+crlf);}
  633.  
  634. {    endif
  635.      return;
  636. // eof - make_pop_code()
  637. enddef
  638.  
  639. //--------------------------------------------------------------
  640. define make_help_code()
  641. //------------------------------------
  642. // Make procedures for the help system
  643. //------------------------------------
  644. if is_help then
  645.      // If the udf file has not already been created, make it.
  646.     if not udf_file then
  647.        if !make_udf() then 
  648.            return 0;
  649.        endif
  650.        // Put up the UDF header
  651.        udf_header()
  652.     endif
  653.     // Make procedures for the help system
  654.     make_help()
  655. endif
  656. if is_help or is_popup then
  657.    // Make shadow procedures
  658.    make_shadow_procs()
  659. endif
  660. return;
  661. enddef
  662.  
  663. //--------------------------------------------------------------
  664. define header()
  665.     // Print Header in program
  666.     print( replicate( "*",80) + crlf);}
  667. *-- Name.......: {filename(fmt_name)}FMT
  668. *-- Date.......: {ltrim( substr( date(),1,8))}
  669. *-- Version....: dBASE IV, Format {FRAME_VER}.1
  670. *-- Notes......: Format files use "" as delimiters!
  671. {   print( replicate( "*",80) + crlf);
  672. enddef
  673.  
  674. //--------------------------------------------------------------
  675. define udf_header()
  676.     // Print Header in UDF program
  677.     print("*"+replicate("-",78)+crlf);}
  678. *-- Name....: {frame_path}u_{rtrim(substr(name,1,6))}.PRG
  679. *-- Date....: {ltrim(SUBSTR(date(),1,8))}
  680. *-- Version.: dBASE IV, Procedure for Format {Frame_ver}.1
  681. *-- Notes...: Procedure file for VALID POPUPs and/or Context Sensitive Help
  682. *-- ........: for {filename(fmt_name)}FMT
  683. {print("*"+replicate("-",78)+crlf);
  684. enddef
  685.  
  686. //--------------------------------------------------------------
  687. define ok_template(cur)
  688.      if cur.FLD_TEMPLATE && !(chr(cur.FLD_VALUE_TYPE) == "D" ||
  689.                               chr(cur.FLD_VALUE_TYPE) == "M") then
  690.         return 1;
  691.      else
  692.         return 0;
  693.      endif
  694. enddef
  695.  
  696. //--------------------------------------------------------------
  697. define ok_coordinates(cur,              // Current cursor
  698.                       xtra_width,       // Additional width to check ie, shadow
  699.                       want_message,     // Display message flag 0:No 1:Yes
  700.                       message)          // Message to display to user
  701.      // Check to see if coordinates of popup or shadow will fit on screen
  702.      // based on the dimensions of the current field
  703.      if nul2zero(cur.COL_POSITN) + len(cur.FLD_TEMPLATE) + xtra_width > 80 then
  704.         if want_message then
  705.            beep(2)                      // UDF in builtin.def
  706.            cls()
  707.            say_center(10,"Error on Field: " + cur.FLD_FIELDNAME)
  708.            say_center(12, message)
  709.            pause(any_key)
  710.         endif
  711.         return 0;
  712.      else
  713.         return 1;
  714.      endif
  715. enddef
  716.  
  717. //--------------------------------------------------------------
  718. define screen_size()
  719.    // Test screen size if display > 2 screen is 43 lines
  720.    display = numset(_flgcolor)
  721.    if display > ega25 then
  722.        scrn_size = 39
  723.        max_pop_row = 36
  724.    else
  725.        max_pop_row = 18
  726.        scrn_size = 21
  727.    endif
  728.  
  729.    // Test to see if status was off before going into form designer
  730.    dB_status = numset(_flgstatus)
  731.    if scrn_size == 21 and !db_status then
  732.       scrn_size = 24
  733.       max_pop_row = 21
  734.    endif
  735.    if scrn_size == 39 and !db_status then // status is off
  736.       scrn_size = 42
  737.       max_pop_row = 39
  738.    endif
  739.    return;
  740. enddef
  741.  
  742. //--------------------------------------------------------------
  743. define display_type()
  744.     // Find out the display type we are working on
  745.     var temp;
  746.     case display of
  747.        mono:   temp = "MONO"
  748.        cga:    temp = "COLOR"
  749.        ega25:  temp = "EGA25"
  750.        mono43: temp = "MONO43"
  751.        ega43:  temp = "EGA43"
  752.      endcase
  753.      return temp;
  754. enddef
  755.  
  756. //--------------------------------------------------------------
  757. define getcolor(f_display,         // Color of the current field
  758.                 f_editable         // Field is SAY or GET
  759.                )
  760.  // Determines the color from f_display and f_editable (GET or SAY)
  761.  enum  Foreground  =   7,
  762.        Intensity   =   8,  // Color
  763.        Background  = 112,
  764.        MIntensity  = 256,
  765.        Reverse     = 512,  // Mono
  766.        Underline   =1024,
  767.        Blink       =2048,
  768.        default     =32768; // Screen set to default
  769.  
  770.  var forgrnd, enhanced, backgrnd, blnk, underln, revrse, use_colors, incolor;
  771.  incolor=""
  772.  
  773.  use_colors  = default & f_display
  774.  forgrnd  = Foreground & f_display
  775.  enhanced = (Intensity & f_display) || (MIntensity & f_display)
  776.  backgrnd = Background & f_display
  777.  blnk     = Blink  & f_display
  778.  underln  = Underline & f_display
  779.  revrse   = Reverse & f_display
  780.  
  781.  if not use_colors then // Use system colors, no colors set in designer
  782.  
  783.     if backgrnd then backgrnd = backgrnd/16 endif
  784.  
  785.     if (display != mono and display != mono43) then
  786.        case forgrnd of
  787.         0: incolor = "n"
  788.         1: incolor = "b"
  789.         2: incolor = "g"
  790.         3: incolor = "bg"
  791.         4: incolor = "r"
  792.         5: incolor = "rb"
  793.         6: incolor = "gr"
  794.         7: incolor = "w"
  795.        endcase
  796.     else
  797.        incolor = "w"
  798.     endif
  799.  
  800.     if revrse then
  801.        incolor = incolor + "i"
  802.     endif
  803.     if underln then
  804.        incolor = incolor + "u"
  805.     endif
  806.     if enhanced then
  807.        incolor = incolor + "+"
  808.     endif
  809.     if blnk then
  810.        incolor = incolor + "*"
  811.     endif
  812.  
  813.     incolor = incolor + "/"
  814.  
  815.     if (display != mono and display != mono43) then
  816.        case backgrnd of
  817.         0: incolor = incolor + "n"
  818.         1: incolor = incolor + "b"
  819.         2: incolor = incolor + "g"
  820.         3: incolor = incolor + "bg"
  821.         4: incolor = incolor + "r"
  822.         5: incolor = incolor + "rb"
  823.         6: incolor = incolor + "gr"
  824.         7: incolor = incolor + "w"
  825.        endcase
  826.     else
  827.        incolor = incolor + "n"
  828.     endif
  829.  
  830.     if f_editable and incolor then
  831.        incolor = incolor + "," + incolor
  832.     endif
  833.  
  834.  endif // use no colors
  835.  return alltrim(incolor);
  836. enddef
  837.  
  838. //--------------------------------------------------------------
  839. define outbox(mbox,            // Border type
  840.               mchar            // Special character of border
  841.              )
  842.    // Output the of Box border and character if any
  843.    var result;
  844.    case mbox of
  845.       0: result = " " // single
  846.       1: result = " DOUBLE "
  847.       2: result = " CHR("+mchar+") "
  848.    endcase
  849.    return result;
  850. enddef
  851.  
  852. //--------------------------------------------------------------
  853. define outcolor()
  854.   // Output the of color of the @ SAY GET or Box
  855.   var result;
  856.   result = "";
  857.   if len(color) > 0 then
  858.      if color_flg then
  859.         // If flag is set output a dBASE continuation ";"
  860.         result = ";" + crlf + space(3)
  861.      endif
  862.      result = result + "COLOR " + color + " "
  863.   endif
  864.   return result;
  865. enddef
  866.  
  867. //--------------------------------------------------------------
  868. define window_def(cur)
  869.    // Build dBASE window command
  870.    var result;
  871.    result = "wndow" + wnd_cnt + " FROM " + Box_Coordinates(cur)
  872.    result = result + outbox(cur.BOX_TYPE, cur.BOX_SPECIAL_CHAR)
  873.    color = getcolor(cur.FLD_DISPLAY, cur.FLD_EDITABLE)
  874.    result = result + outcolor()
  875.    return result;
  876. enddef
  877.  
  878. //--------------------------------------------------------------
  879. define box_coordinates(cur)             // Pass in foreach cursor
  880.    // Build box coordinates for a dBASE window command
  881.    var result, temp_page, line_cnt;
  882.    temp_page = page_cnt;
  883.  
  884.    // Adjust box coordinates so that negative numbers are not generated
  885.    do while ( nul2zero(cur.BOX_TOP) - (scrn_size * temp_page) ) <= 1
  886.          temp_page = temp_page - 1
  887.    enddo
  888.    if page_cnt == 1 then
  889.         temp_page = 0
  890.    endif
  891.    if page_cnt == 2 then
  892.         temp_page = 1
  893.    endif
  894.    if !temp_page then
  895.       line_cnt = 0
  896.    else
  897.       line_cnt = (scrn_size * temp_page) + (1 * temp_page)
  898.    endif
  899.  
  900.    result = nul2zero(cur.BOX_TOP) - line_cnt +","
  901.    result = result + nul2zero(cur.BOX_LEFT) + " TO "
  902.    temp = nul2zero(cur.BOX_TOP) + cur.BOX_HEIGHT - line_cnt - 1
  903.    if temp > scrn_size then temp = scrn_size endif
  904.    result = result + temp + "," + (nul2zero(cur.BOX_LEFT) + cur.BOX_WIDTH - 1)
  905.    return result;
  906. enddef
  907.  
  908. //--------------------------------------------------------------
  909. define carry_flds()
  910.    // Build dBASE SET CARRY command
  911.    carry_len = carry_lent = 13
  912.    carry_first = 0
  913.    foreach FLD_ELEMENT flds
  914.       if FLD_CARRY then
  915.          carry_len = carry_len + len(FLD_FIELDNAME + ",")
  916.          carry_lent = carry_lent + len(FLD_FIELDNAME + ",")
  917.          if carry_lent > 1000 then
  918.             print(crlf + "SET CARRY TO ")
  919.             carry_len = carry_lent = 13
  920.          endif
  921.          if carry_len > 75 then print(";" + crlf + "  ")  carry_len = 2 endif
  922.          temp = cap_first(FLD_FIELDNAME)
  923.          if !carry_first then
  924.             print(temp)
  925.             carry_first = 1
  926.          else
  927.             print("," + temp)
  928.          endif
  929.       endif
  930.     next flds
  931.     print(" ADDITIVE");
  932.  return;
  933. enddef
  934.  
  935. //--------------------------------------------------------------
  936.  
  937. define make_fmt()
  938.    // Attempt to create program (fmt) file.
  939.    default_drv = strset(_defdrive)  // grab default drive from dBASE
  940.    fmt_name = FRAME_PATH + NAME     // Put path on to object name
  941.    if not fileok(fmt_name) then
  942.       if !default_drv then
  943.          fmt_name = NAME
  944.       else
  945.          fmt_name = default_drv + ":" + NAME
  946.       endif
  947.    endif
  948.    fmt_name = upper(fmt_name)
  949.    if not create(fmt_name+".FMT") then
  950.         pause(fileroot(fmt_name) +".FMT" + read_only + any_key)
  951.         return 0;
  952.      endif
  953.    return 1;
  954. enddef
  955. //--------------------------------------------------------------
  956.  
  957. define make_udf()
  958.    // Attempt to create dBASE procedure (prg) file.
  959.    var udf_root_file_name;
  960.    udf_root_file_name =  frame_path + "u_" + rtrim(substr(name,1,6))
  961.    if not create( udf_root_file_name + ".PRG") then
  962.       pause(udf_root_file_name + ".PRG" + read_only + any_key)
  963.       return 0;
  964.    endif
  965.    // Force dBASE to recompile the .prg
  966.    fileerase(udf_root_file_name + ".DBO")
  967.    udf_file = 1 // Global flag to determine if UDF file was created
  968.    return 1;
  969. enddef
  970.  
  971. //--------------------------------------------------------------
  972. define check_for_popups()
  973. // Check for "popup" string for this fmt file
  974. foreach FLD_ELEMENT flds
  975.     if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" then
  976.        is_popup = 1
  977.        exit
  978.     endif
  979. next flds
  980. return is_popup;
  981. enddef
  982.  
  983. //--------------------------------------------------------------
  984. define check_for_help()
  985.    // Check for help support for this fmt file
  986.    // Looking for a .dBF with the same name as the .fmt file
  987.    hlp_name = frame_path + substr(fileroot(fmt_name), 1, 6) + "_H"
  988.  
  989.    if fileexist(hlp_name + ".DBF") and fileexist(hlp_name + ".DBT") then
  990.       is_help = 1      // Global flag for help support
  991.    endif
  992. return is_help;
  993. enddef
  994.  
  995. //--------------------------------------------------------------
  996. define new_page(cur)               // Cur: Current cursor
  997.    // Checks for a page break and adjusts line_cnt and page_cnt
  998.    if nul2zero(cur.ROW_POSITN) - line_cnt > scrn_size then
  999.       line_cnt = line_cnt + scrn_size + 1;
  1000.       ++page_cnt;
  1001.       return 1;
  1002.    endif
  1003. return 0;
  1004. enddef
  1005.  
  1006. //--------------------------------------------------------------
  1007. define parse_line( before,         // Out: chars before the look_for string
  1008.                    input,          // In:  line being parsed
  1009.                    look_for        // In:  string searched for
  1010.                  )                 // Rtn: chars after the look_for string
  1011. // If the look_for sting is not found, the before sting will equal the
  1012. // input string, and the returned value will be NUL
  1013.      var location;
  1014.  
  1015.      location = at(look_for, UPPER(input))
  1016.      if location == 0 then
  1017.           before = input
  1018.           return ( "" );
  1019.      endif
  1020.  
  1021.      before = substr( input, 1, location-1)
  1022.      return ( substr( input,
  1023.                       location+len(look_for),
  1024.                       len(input)
  1025.                     )
  1026.             );
  1027.  
  1028. // end: parse_line()
  1029. enddef
  1030.  
  1031. //--------------------------------------------------------------
  1032. // Parsing routines for pulling objects out of the VALID string
  1033. // "POPUP" = "file->fld_name ORDER key_fld REQ"
  1034. // 1234567890123456789012345678901234567890123
  1035. //            1         2         3         4
  1036. define get_file(valid_str)
  1037.      var  s_arrow,            // String "->"
  1038.           test,
  1039.           s_equal,            // String "="
  1040.           next_alpha,
  1041.           at_alias,
  1042.           s_before,           // String before the searched for item
  1043.           r_target,           // Remainder of the target string after item
  1044.           use_name;           // Return for file
  1045.  
  1046.      s_arrow = "->"
  1047.      s_equal = "="
  1048.      r_target = parse_line( s_before, valid_str, s_equal )      // ' "file->...'
  1049.      next_alpha = atalpha(r_target)                             // 3
  1050.      at_alias = at(s_arrow, r_target)                           // 7
  1051.      use_name = substr(r_target,next_alpha,at_alias-next_alpha) // 'file'
  1052.  
  1053.      return cap_first(use_name);
  1054. enddef
  1055.  
  1056. //--------------------------------------------------------------
  1057. define get_key(valid_str)
  1058.      var  s_order,            // String "ORDER "
  1059.           at_space,
  1060.           s_before,           // String before the searched for item
  1061.           r_target,           // Remainder of the target string after item
  1062.           order_tag;          // Search TAG to ORDER BY
  1063.  
  1064.      s_order = "ORDER "
  1065.      r_target = parse_line( s_before, valid_str, s_order ) // 'key_fld REQ'
  1066.      at_space = at(" ",r_target)
  1067.      if at_space == 0 then
  1068.           order_tag = substr(r_target, 1, len(r_target)-1) // 'key_fld"'
  1069.      else
  1070.           order_tag = substr(r_target, 1, at_space-1)
  1071.      endif
  1072.      return cap_first(order_tag);
  1073. enddef
  1074.  
  1075. //--------------------------------------------------------------
  1076. define get_field(valid_str)
  1077.      var  s_arrow,            // String "->"
  1078.           at_space,
  1079.           s_before,           // String before the searched for item
  1080.           r_target,           // Remainder of the target string after item
  1081.           fld_name;           // Field name to lookup in target file
  1082.  
  1083.      s_arrow = "->"
  1084.      r_target = parse_line( s_before,
  1085.                             valid_str, s_arrow ) // 'fld_name ORDER...'
  1086.      at_space = at(" ",r_target)
  1087.  
  1088.      fld_name = ( at_space == 0 ? r_target : substr(r_target, 1, at_space-1) );
  1089.  
  1090.      return cap_first(fld_name);
  1091. enddef
  1092.  
  1093. //--------------------------------------------------------------
  1094. define get_popname(valid_str)
  1095.      // Create popup name
  1096.      return ( lower( "u_" + substr( get_field( valid_str),1,6) ) );
  1097. enddef
  1098.  
  1099. //--------------------------------------------------------------
  1100. define get_pop_shadow(field_template)   // Pass in FLD_TEMPLATE to deter. shadow
  1101.      if trow_positn < max_pop_row then
  1102.         trow_positn + 1},{tcol_positn},{scrn_size-1},{tcol_positn+len(Field_template)+1}
  1103. {    else
  1104.         trow_positn - 11},{tcol_positn},{trow_positn - 1},{tcol_positn+len(Field_template)+1}
  1105. {    endif
  1106.      return;
  1107. enddef
  1108.  
  1109. //---------------------------------------------------------------
  1110. define get_udfname(fld_str)
  1111.      // Create UDF name
  1112.      return cap_first( "u_" + substr( fld_str,1,6) );
  1113. enddef
  1114.  
  1115. //--------------------------------------------------------------
  1116. define is_required(valid_str)
  1117.      // Determines if the field is required before moving to the next field
  1118.      return ( ( at(" REQ ",  upper(valid_str)) ? 1 : 0 ) or 
  1119.               ( at(" REQ\"", upper(valid_str)) ? 1 : 0 )
  1120.             );
  1121. enddef
  1122.  
  1123. //--------------------------------------------------------------
  1124. define is_shadow(valid_str)
  1125.      // Determines if the user wants shadowing for popup
  1126.      return ( ( at(" SHADOW ",  upper(valid_str)) ? 1 : 0 ) or 
  1127.               ( at(" SHADOW\"", upper(valid_str)) ? 1 : 0 )
  1128.             );
  1129. enddef
  1130.  
  1131. //--------------------------------------------------------------
  1132. define make_shadow_procs()
  1133.      // Make the dBASE code for shadowing
  1134.      print("*"+replicate("-",78)+crlf);
  1135. }
  1136. PROCEDURE Shadowg                       && displays shadow that grows
  1137.   PARAMETER x1,y1,x2,y2
  1138.   PRIVATE   x1,y1,x2,y2
  1139.  
  1140.   x0 = x2+1
  1141.   y0 = y2+2
  1142.   dx = 1
  1143.   dy = (y2-y1) / (x2-x1)
  1144.   DO WHILE x0 <> x1 .OR. y0 <> y1+2
  1145.      @ x0,y0 FILL TO x2+1,y2+2 COLOR n+/n
  1146.      x0 = IIF(x0<>x1,x0 - dx,x0)
  1147.      y0 = IIF(y0<>y1+2,y0 - dy,y0)
  1148.      y0 = IIF(y0<y1+2,y1+2,y0)
  1149.   ENDDO
  1150.  
  1151. RETURN
  1152. *-- EOP: shadowg
  1153. {    return;
  1154. enddef
  1155.  
  1156. //--------------------------------------------------------------
  1157.  define make_help()
  1158. // Make the dBASE code for help
  1159. }
  1160. PROCEDURE Help
  1161. {    lmarg(offset)}
  1162. *-- Activates the HELP window
  1163. PARAMETER lc_var
  1164. PRIVATE ALL LIKE ??_*
  1165. SET CURSOR OFF
  1166.  
  1167. *-- Select workarea and open Help dbf
  1168. lc_area = ALIAS()
  1169. SELECT SELECT()
  1170. USE {fileroot(hlp_name)} ORDER fld_name NOUPDATE   && Open HELP .dbf
  1171.  
  1172. SEEK lc_var
  1173. IF FOUND()                             && If found show Help
  1174.   ln_t = 5
  1175.   ln_l = 6
  1176.   ln_b = 15
  1177.   ln_r = 74
  1178.   ON KEY LABEL F3 DO Toggle
  1179.   DEFINE WINDOW z_help FROM ln_t+1, ln_l+2 TO ln_b-1, ln_r-2 NONE
  1180.   ON ERROR lc_error=error()
  1181.   SAVE SCREEN TO zz_help
  1182.  
  1183.   *-- Make Help Box
  1184.   DO shadowg WITH ln_t, ln_l, ln_b, ln_r
  1185.   @ ln_t+1, ln_l+1 CLEAR TO ln_b-1, ln_r-1
  1186.   @ ln_t, ln_l TO ln_b, ln_r DOUBLE
  1187.  
  1188.   ln_memline = SET("MEMO")
  1189.   SET MEMOWIDTH TO 65
  1190.   IF MEMLINES(fld_help) > 9
  1191.     @ ln_t+1,ln_r SAY CHR(24)
  1192.     @ ln_b-1,ln_r SAY CHR(25)
  1193.   ENDIF
  1194.   lc_string = CHR(185)+ [ Help for ] + TRIM(fld_headng) +[ ] + CHR(204)
  1195.   lc_message = IIF(MEMLINES(fld_help) > 9, ;
  1196.                   "{help_msg1 + help_msg2}", ;
  1197.                   "{help_msg2}" ;
  1198.                   )
  1199.  
  1200.   @ ln_t,CENTER(lc_string,80) SAY lc_string
  1201.   @ 0,0 GET fld_help OPEN WINDOW z_help MESSAGE lc_message
  1202.   READ
  1203.   SET MEMOWIDTH TO ln_memline
  1204.   ON ERROR
  1205.   ON KEY LABEL F3
  1206.   RELEASE WINDOW z_help
  1207.   RESTORE SCREEN FROM zz_help
  1208.   RELEASE SCREEN zz_help
  1209. ENDIF
  1210. SET MESSAGE TO
  1211. SET CURSOR ON
  1212. USE                                              && Close help file
  1213. SELECT (lc_area)                                 && Back to edit work area
  1214. {    lmarg(0)}
  1215. RETURN
  1216. *-- EOP: HELP
  1217.  
  1218. {    print("*"+replicate("-",78)+crlf);}
  1219. PROCEDURE Toggle
  1220. {    lmarg(offset)}
  1221. *-- Toggles the Help message back to the original screen
  1222. SAVE SCREEN to Toggle
  1223. RESTORE SCREEN FROM zz_help
  1224. SET MESSAGE TO "Press any key..."
  1225. mwait = INKEY(15)
  1226. RESTORE SCREEN FROM Toggle
  1227. RELEASE SCREEN Toggle
  1228. SET MESSAGE TO "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Ctrl-End   See Org. Screen: F3"
  1229. {    lmarg(0)}
  1230. RETURN
  1231. *-- EOP: Toggle
  1232.  
  1233. {    print("*"+replicate("-",78)+crlf);}
  1234. FUNCTION Center
  1235. *-- UDF to center a string.
  1236. *-- lc_string = String to center
  1237. *-- ln_width = Width of screen to center in
  1238. *--
  1239. *-- Ex. @ 15,center(string,80) say string
  1240. *-- Will center the <string> withing 80 columns
  1241. PARAMETER lc_string, ln_width
  1242. RETURN ((ln_width/2)-(LEN(lc_string)/2))
  1243. {return;
  1244. enddef
  1245. //--------------------------------------------------------------
  1246. define fmt_doc_body()
  1247.  
  1248. testing = line_cnt = wnd_cnt = 0
  1249. foreach ELEMENT k
  1250.  
  1251. //
  1252.    if ELEMENT_TYPE == @FLD_ELEMENT then
  1253.       new_page(k)
  1254.       if FLD_FIELDTYPE == memvar then}
  1255. Variable Name:{space(indent_no - 14)}{cap_first(FLD_FIELDNAME)}
  1256. {     else}
  1257. Field Name:{space(indent_no - 11)}{cap_first(FLD_FIELDNAME)} \
  1258. {        if FLD_FIELDTYPE == calc then}
  1259. (Calculated)
  1260. {        else}
  1261.  
  1262. {        endif}
  1263. {     endif}
  1264. Field Type:{space(indent_no - 11)}\
  1265. {     case FLD_VALUE_TYPE of
  1266.          case type_char:}
  1267. Character
  1268. {        case type_date:}
  1269. Date
  1270. {        case type_float:}
  1271. Floating Point
  1272. {        case type_bool:}
  1273. Logical
  1274. {        case type_memo:}
  1275. Memo
  1276. {        otherwise:}
  1277. Numeric
  1278. {     endcase
  1279.       if Ok_Template(k) then
  1280.          remain_str = ""}
  1281. Picture Clause:{space(indent_no - 15)}\
  1282. {wrap_string(FLD_TEMPLATE,width_of_wrap,0,remain_str);}
  1283. {remain_str}
  1284.  
  1285. {     else}
  1286. Picture Clause:{space(indent_no - 15)}None
  1287. {     endif}
  1288.  
  1289. {     print( replicate( "-",78) + crlf);}
  1290.  
  1291. {     if FLD_PICFUN then}
  1292. Picture Functions:{space(indent_no - 18)}{get_functions(k);}
  1293. {     print( replicate( "-",78) + crlf);}
  1294.  
  1295. {     endif
  1296.       if FLD_FIELDTYPE == calc then
  1297.          if FLD_DESCRIPT then
  1298.             remain_str = ""}
  1299. Description:{space(indent_no - 12)}\
  1300. {wrap_string(FLD_DESCRIPT,width_of_wrap,0,"");}
  1301. {remain_str}
  1302.  
  1303.  
  1304. {        endif}
  1305. Expression:{space(indent_no - 11)}\
  1306. {        last_at = 0
  1307.          remain_str = ""
  1308.          foreach FLD_EXPRESSION cntr1 in k}
  1309. {wrap_string(FLD_EXPRESSION,width_of_wrap,last_at,remain_str);}\
  1310. {        next}
  1311. {remain_str}
  1312.  
  1313.  
  1314. {     print( replicate( "-",78) + crlf);}
  1315.  
  1316. {     endif
  1317.       if chr(FLD_VALUE_TYPE) == "M" && FLD_MEM_TYP then
  1318.          if wnd_cnt < 20  then ++wnd_cnt endif}
  1319. Window Name:{space(indent_no - 12)}Wndow{wnd_cnt}
  1320. Window Coordinates:{space(indent_no - 19)}{Doc_Box(k)}
  1321.  
  1322. {     print( replicate( "-",78) + crlf);}
  1323.  
  1324. {     endif
  1325.       if FLD_L_BOUND or FLD_U_BOUND then}
  1326. Valid Range:{space(indent_no - 12)}\
  1327. {        if FLD_L_BOUND then}
  1328. From: \
  1329. {           last_at = 6
  1330.             remain_str = ""
  1331.             foreach FLD_L_BOUND cntr1 in k}
  1332. {wrap_string(FLD_L_BOUND,width_of_wrap,last_at,remain_str);}\
  1333. {           next}
  1334. {remain_str}
  1335.  
  1336. {        endif
  1337.          if FLD_U_BOUND then
  1338.             if !FLD_L_BOUND then}
  1339. To:   \
  1340. {           else}
  1341.  
  1342. {space(indent_no)}To:   \
  1343. {           endif
  1344.             last_at = 6
  1345.             remain_str = ""
  1346.             foreach FLD_U_BOUND cntr1 in k}
  1347. {wrap_string(FLD_U_BOUND,width_of_wrap,last_at,remain_str);}\
  1348. {           next}
  1349. {remain_str}
  1350.  
  1351. {       endif}
  1352.  
  1353. {     print( replicate( "-",78) + crlf);}
  1354.  
  1355. {     endif
  1356.       if FLD_OK_COND then}
  1357. Accept Value When:{space(indent_no - 18)}\
  1358. {        last_at = 0
  1359.          remain_str = ""
  1360.          foreach FLD_OK_COND cntr1 in k}
  1361. {wrap_string(FLD_OK_COND,width_of_wrap,last_at,remain_str);}\
  1362. {        next}
  1363. {remain_str}
  1364.  
  1365. {        if FLD_REJ_MSG then
  1366.             remain_str = ""}
  1367.  
  1368. Unaccepted Message:{space(indent_no - 19)}\
  1369. {wrap_string(FLD_REJ_MSG,width_of_wrap,0,"");}\
  1370. {remain_str}
  1371.  
  1372. {        endif}
  1373.  
  1374. {     print( replicate( "-",78) + crlf);}
  1375.  
  1376. {     endif // FLD_OK_COND
  1377.       if FLD_ED_COND then}
  1378. Edit Value If:{space(indent_no - 14)}\
  1379. {           last_at = 0
  1380.             remain_str = ""
  1381.             foreach FLD_ED_COND cntr1 in k}
  1382. {wrap_string(FLD_ED_COND,width_of_wrap,last_at,remain_str);}\
  1383. {           next}
  1384. {remain_str}
  1385.  
  1386.  
  1387. {     print( replicate( "-",78) + crlf);}
  1388.  
  1389. {endif
  1390.       if FLD_DEF_VAL then}
  1391. Default Value:{space(indent_no - 14)}\
  1392. {        last_at = 0
  1393.          remain_str = ""
  1394.          foreach FLD_DEF_VAL cntr1 in k}
  1395. {wrap_string(FLD_DEF_VAL,width_of_wrap,last_at,remain_str);}\
  1396. {        next}
  1397. {remain_str}
  1398.  
  1399.  
  1400. {     print( replicate( "-",78) + crlf);}
  1401.  
  1402. {     endif
  1403.       if FLD_HLP_MSG then
  1404. testing = 1
  1405.             remain_str = ""}
  1406. Help Message:{space(indent_no - 13)}\
  1407. {wrap_string(FLD_HLP_MSG,width_of_wrap,0,"");}
  1408. {remain_str}
  1409.  
  1410.  
  1411. {     print( replicate( "-",78) + crlf);}
  1412.  
  1413. {     testing = 0
  1414. endif
  1415.       if !FLD_EDITABLE or FLD_CARRY}
  1416. Attributes:{space(indent_no - 11)}\
  1417. {        if !FLD_EDITABLE then}
  1418. Read Only\
  1419. {           if FLD_CARRY then}
  1420. , \
  1421. {           endif}
  1422. {        endif
  1423.          if FLD_CARRY}
  1424. Carried Forward\
  1425. {        endif}
  1426.  
  1427.  
  1428. {     print( replicate( "-",78) + crlf);}
  1429.  
  1430. {     endif}
  1431. Position:{space(indent_no - 9)}Row: {ROW_POSITN - line_cnt}    \
  1432. Column: {COL_POSITN}    Screen No.: {page_cnt}
  1433.  
  1434. {     print( replicate( "=",78) + crlf);
  1435.       print( replicate( "=",78) + crlf);}
  1436.  
  1437. {  endif
  1438.    ++cnt;
  1439. next k
  1440. return;
  1441. // eof - fmt_file_body()
  1442. enddef
  1443.  
  1444. //--------------------------------------------------------------
  1445.  
  1446. //--------------------------------------------------------------
  1447. define get_functions(c)
  1448.    if c.FLD_PICFUN then
  1449.       first = 1
  1450.       if at("Z", c.FLD_PICFUN) then}
  1451. Leave blank when value is Zero
  1452. {        first = 0
  1453.       endif
  1454.       if at("L", c.FLD_PICFUN) then
  1455.          if first then}
  1456. Pad number with leading zeroes
  1457. {           first = 0
  1458.          else}
  1459. {space(indent_no)}Pad number with leading zeroes
  1460. {        endif
  1461.       endif
  1462.       if at("$", c.FLD_PICFUN) then
  1463.          if first then}
  1464. Display number in financial format
  1465. {           first = 0
  1466.          else}
  1467. {space(indent_no)}Display number in financial format
  1468. {        endif
  1469.       endif
  1470.       if at("^", c.FLD_PICFUN) then
  1471.          if first then}
  1472. Display number in exponential format
  1473. {           first = 0
  1474.          else}
  1475. {space(indent_no)}Display in number exponential format
  1476. {        endif
  1477.       endif
  1478.       if at("C", c.FLD_PICFUN) then
  1479.          if first then}
  1480. Follow positive credits with "CR"
  1481. {           first = 0
  1482.          else}
  1483. {space(indent_no)}Follow postive credits with "CR"
  1484. {        endif
  1485.       endif
  1486.       if at("X", c.FLD_PICFUN) then
  1487.          if first then}
  1488. Follow negative debits with "DB"
  1489. {           first = 0
  1490.          else}
  1491. {space(indent_no)}Follow negative debits with "DB"
  1492. {        endif
  1493.       endif
  1494.       if at("(", c.FLD_PICFUN) then
  1495.          if first then}
  1496. Put parentheses around negative numbers
  1497. {           first = 0
  1498.          else}
  1499. {space(indent_no)}Put parentheses around negative numbers
  1500. {        endif
  1501.       endif
  1502.       if at("T", c.FLD_PICFUN) then
  1503.          if first then}
  1504. Trim trailing blanks from expression
  1505. {           first = 0
  1506.          else}
  1507. {space(indent_no)}Trim trailing blanks from expression
  1508. {        endif
  1509.       endif
  1510.       if at("B", c.FLD_PICFUN) then
  1511.          if first then}
  1512. Left align expression
  1513. {           first = 0
  1514.          else}
  1515. {space(indent_no)}Left align expression
  1516. {        endif
  1517.       endif
  1518.       if at("I", c.FLD_PICFUN) then
  1519.          if first then}
  1520. Center align expression
  1521. {           first = 0
  1522.          else}
  1523. {space(indent_no)}Center align expression
  1524. {        endif
  1525.       endif
  1526.       if at("A", c.FLD_PICFUN) then
  1527.          if first then}
  1528. Allow input of alphabetic characters only
  1529. {           first = 0
  1530.          else}
  1531. {space(indent_no)}Allow input alphabetic characters only
  1532. {        endif
  1533.       endif
  1534.       if at("!", c.FLD_PICFUN) then
  1535.          if first then}
  1536. Convert entry/expression to uppercase
  1537. {           first = 0
  1538.          else}
  1539. {space(indent_no)}Convert entry/expression to uppercase
  1540. {        endif
  1541.       endif
  1542.       if at("R", c.FLD_PICFUN) then
  1543.          if first then}
  1544. Literals in template are not part of data
  1545. {           first = 0
  1546.          else}
  1547. {space(indent_no)}Literals in template are not part of data
  1548. {        endif
  1549.       endif
  1550.       if at("S", c.FLD_PICFUN) then
  1551.          if first then}
  1552. Scroll within a display width of: {c.FLD_PIC_SCROLL}
  1553. {           first = 0
  1554.          else}
  1555. {space(indent_no)}Scroll within a display width of: {c.FLD_PIC_SCROLL}
  1556. {        endif
  1557.       endif
  1558.       if at("M", c.FLD_PICFUN) then
  1559.          if first then}
  1560. Selection to be made from the following choices: 
  1561. {        first = 0
  1562.          else}
  1563. {space(indent_no)}Selection to be made from the following choices: 
  1564. {        endif
  1565.          last_at = 0
  1566.          remain_str = ""
  1567.          first_test = 1
  1568.          foreach FLD_PIC_CHOICE cntr1 in c
  1569.             if first_test then}
  1570. {space(indent_no)}{wrap_string(FLD_PIC_CHOICE,width_of_wrap,last_at,remain_str);}\
  1571. {              first_test = 0
  1572.             else}
  1573. {wrap_string(FLD_PIC_CHOICE,width_of_wrap,last_at,remain_str);}\
  1574. {           endif
  1575.          next}
  1576. {remain_str}
  1577.  
  1578. {     endif
  1579.    endif
  1580. enddef
  1581.  
  1582. //--------------------------------------------------------------
  1583. define make_fmt_doc()
  1584.    // Attempt to create document file.
  1585.    default_drv = strset(_defdrive)  // grab default drive from dBASE
  1586.    fmt_name = FRAME_PATH + NAME     // Put path on to object name
  1587.    if not fileok(fmt_name) then
  1588.       if !default_drv then
  1589.          fmt_name = NAME
  1590.       else
  1591.          fmt_name = default_drv + ":" + NAME
  1592.       endif
  1593.    endif
  1594.    fmt_name = upper(fmt_name)
  1595.    if not create(fmt_name+".DOC") then
  1596.         pause(fileroot(fmt_name) +".DOC" + read_only + any_key)
  1597.         return 0;
  1598.      endif
  1599.    return 1;
  1600. enddef
  1601.  
  1602. //--------------------------------------------------------------
  1603. define doc_header()
  1604.     // Print Header in program
  1605.     print( replicate( "=",78) + crlf);
  1606.     print( replicate( "*",78) + crlf);}
  1607. *
  1608. *-- Data Description For: {filename(fmt_name)}FMT
  1609. *-- Date................: {ltrim( substr( date(),1,8))}
  1610. *-- Version.............: dBASE IV, Format {FRAME_VER}.1
  1611. *
  1612. {   print( replicate( "*",78) + crlf);
  1613.     print( replicate( "=",78) + crlf);}
  1614.  
  1615. {
  1616. enddef
  1617.  
  1618. //--------------------------------------------------------------
  1619. define doc_box(cur)             // Pass in foreach cursor
  1620.    // Build box coordinates for a dBASE window command
  1621.    var result, temp_page, line_cnt;
  1622.    temp_page = page_cnt;
  1623.  
  1624.    // Adjust box coordinates so that negative numbers are not generated
  1625.    do while ( nul2zero(cur.BOX_TOP) - (scrn_size * temp_page) ) <= 1
  1626.          temp_page = temp_page - 1
  1627.    enddo
  1628.    if page_cnt == 1 then
  1629.         temp_page = 0
  1630.    endif
  1631.    if page_cnt == 2 then
  1632.         temp_page = 1
  1633.    endif
  1634.    if !temp_page then
  1635.       line_cnt = 0
  1636.    else
  1637.       line_cnt = (scrn_size * temp_page) + (1 * temp_page)
  1638.    endif
  1639.  
  1640.    result = nul2zero(cur.BOX_TOP) - line_cnt + ", "
  1641.    result = result + nul2zero(cur.BOX_LEFT) + "    To: "
  1642.    temp = nul2zero(cur.BOX_TOP) + cur.BOX_HEIGHT - line_cnt - 1
  1643.    if temp > scrn_size then temp = scrn_size endif
  1644.    result = result + temp + ", " + (nul2zero(cur.BOX_LEFT) + cur.BOX_WIDTH - 1)
  1645. "From: " + result
  1646. enddef
  1647.  
  1648. //--------------------------------------------------------------
  1649. define wrap_string(string2wrap, line_width, last_at, left_over)
  1650.    if len(left_over) + len(alltrim(string2wrap)) > 237 then
  1651.       parse_str = left_over + substr(alltrim(string2wrap), 1, len(alltrim(string2wrap)) - len(left_over))
  1652.       left_over = substr(alltrim(string2wrap), len(alltrim(string2wrap)) - len(left_over) + 1)
  1653.    else
  1654.       parse_str = left_over + alltrim(string2wrap)
  1655.       left_over = ""
  1656.    endif
  1657.    first_time = 1
  1658.    do while len(parse_str) + len(left_over) > line_width - last_at
  1659.       breakpt1 = 0
  1660.       temp_str = parse_str
  1661.       do while breakpt1 + at(" ", temp_str) < line_width - last_at && at(" ", temp_str)
  1662.          breakpt1 = breakpt1 + at(" ", temp_str)
  1663.          temp_str = substr(temp_str, at(" ", temp_str) + 1)
  1664.       enddo
  1665.       breakpt2 = 0
  1666.       temp_str = parse_str
  1667.       do while breakpt2 + at(")", temp_str) < line_width - last_at && at(")", temp_str)
  1668.          breakpt2 = breakpt2 + at(")", temp_str)
  1669.          temp_str = substr(temp_str, at(")", temp_str) + 1)
  1670.       enddo
  1671.       if !breakpt1 || breakpt1 > breakpt2 then
  1672.          if !breakpt1 then
  1673.             if first_time then}
  1674. {alltrim(substr(parse_str, 1, line_width - last_at))}
  1675. {              first_time = 0
  1676.                parse_str = alltrim(substr(parse_str, (line_width - last_at) + 1, len(parse_str) - (line_width - last_at)))
  1677.                last_at = 0
  1678.             else}
  1679.  
  1680. {space(indent_no) + alltrim(substr(parse_str, 1, line_width))}
  1681. {              parse_str = alltrim(substr(parse_str, line_width + 1, len(parse_str) - line_width))
  1682.             endif
  1683.          else
  1684.             if first_time then}
  1685. {alltrim(substr(parse_str, 1, breakpt1))}
  1686. {              first_time = 0
  1687.                last_at = 0
  1688.             else}
  1689.  
  1690. {space(indent_no) + alltrim(substr(parse_str, 1, breakpt1))}
  1691. {           endif
  1692.             parse_str = alltrim(substr(parse_str, breakpt1 + 1, len(parse_str) - breakpt1))
  1693.          endif
  1694.       else
  1695.          if first_time then}
  1696. {alltrim(substr(parse_str, 1, breakpt2))}
  1697. {           first_time = 0
  1698.             parse_str = alltrim(substr(parse_str, breakpt2 + 1, len(parse_str) - breakpt2))
  1699.             last_at = 0
  1700.          else}
  1701.  
  1702. {space(indent_no) + alltrim(substr(parse_str, 1, breakpt2))}
  1703. {        endif
  1704.          parse_str = alltrim(substr(parse_str, breakpt2 + 1, len(parse_str) - breakpt2))
  1705.       endif
  1706.       if left_over then
  1707.          if len(left_over) + len(parse_str) <= 237 then
  1708.             parse_str = parse_str + left_over
  1709.             left_over = ""
  1710.          endif
  1711.       endif 
  1712.    enddo
  1713.    if first_time then}
  1714. {alltrim(parse_str)}\
  1715. {  else
  1716.       breakpt1 = 0
  1717.       temp_str = alltrim(parse_str)
  1718.       do while at(" ", temp_str)
  1719.          breakpt1 = breakpt1 + at(" ", temp_str)
  1720.          temp_str = substr(temp_str, at(" ", temp_str) + 1)
  1721.       enddo
  1722.       breakpt2 = 0
  1723.       temp_str = alltrim(parse_str)
  1724.       do while at(")", temp_str)
  1725.          breakpt2 = breakpt2 + at(")", temp_str)
  1726.          temp_str = substr(temp_str, at(")", temp_str) + 1)
  1727.       enddo
  1728.       if breakpt1 >= breakpt2 then
  1729.          if !breakpt1 then
  1730.             last_at = 0
  1731.             remain_str = parse_str
  1732.             test1 = ""}
  1733.  
  1734. {space(indent_no)}\
  1735. {        else}
  1736.  
  1737. {space(indent_no) + substr(parse_str, 1, breakpt1)}\
  1738. {           if len(parse_str) > breakpt1 then
  1739.                remain_str = substr(parse_str, breakpt1 + 1)
  1740.             endif
  1741.             last_at = breakpt1
  1742.          endif
  1743.       else}
  1744.  
  1745. {space(indent_no) + substr(parse_str, 1, breakpt2)}\
  1746. {        if len(parse_str) > breakpt2 then
  1747.             remain_str = substr(parse_str, breakpt2 + 1)
  1748.          endif
  1749.          last_at = breakpt2
  1750.       endif
  1751.    endif
  1752. enddef   
  1753.  
  1754. // EOP FORM.COD
  1755.  
  1756. }
  1757.